Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/communic/pclvbw10/simpline.bas

BASIC Source File | 1996-02-09 | 4KB | 185 lines

' SIMPLINE.BAS

Option Explicit

Dim FatalFlag As Integer
Dim Code As Integer

Sub Aborting ()
  Dim Code As Integer
  SIMPLE.Print "Fatal Error, Aborting..."
  Code = SioDone(ThePort)
  End
End Sub

Sub DisplayChar (ByVal C As Integer)
  Dim Row As Integer
  Dim Col As Integer
  C = &H7F And C
  'process char
  If C = 13 Then
    'carriage control
    CurrentCol = 0
    'plus assumed line feed
    If CurrentRow < 23 Then
      CurrentRow = CurrentRow + 1
      'print CR+LF
      SIMPLE.Print
    Else
      'scroll !
      SIMPLE.Cls
      For Row = 0 To 22
        'print row
        ScreenBuffer(Row) = ScreenBuffer(Row + 1)
        SIMPLE.Print ScreenBuffer(Row)
      Next Row
      'clear bottom row
      ScreenBuffer(23) = Space$(80)
    End If
  ElseIf C = 10 Then
    'throw away line feeds
  Else
    'not CR or LF
    CurrentCol = CurrentCol + 1
    If CurrentCol > 79 Then
      'throw away !
      Exit Sub
    Else
      'save in screen buffer & display
      Mid$(ScreenBuffer(CurrentRow), CurrentCol, 1) = Chr$(C)
      SIMPLE.Print Chr$(C);
    End If
  End If
End Sub

Sub DisplayString (Text As String)
  Dim I As Integer
  Dim Length As Integer
  Length = Len(Text)
  For I = 1 To Length
    Call DisplayChar(Asc(Mid$(Text, I, 1)))
  Next I
  Call DisplayChar(13)
End Sub

Sub GetIncoming ()
  Dim I As Integer
  Dim TheChar As Integer
  For I = 1 To 82
    TheChar = SioGetc(ThePort, 0)
    If TheChar >= 0 Then
      '''IncomingCount = IncomingCount + 1
      Call DisplayChar(TheChar)
    Else
      Exit For
    End If
  Next I
End Sub

Sub GoOffLine ()
  Dim Code As Integer
  OnLineFlag = 0
  'shut down port
  Code = SioDone(ThePort)
  'free DOS memory
  If TxSelector <> 0 Then
    Code = GlobalPageUnlock(TxSelector)
    Code = GlobalDosFree(TxSelector)
    TxSelector = 0
  End If
  If RxSelector <> 0 Then
    Code = GlobalPageUnlock(RxSelector)
    Code = GlobalDosFree(RxSelector)
    RxSelector = 0
  End If

End Sub

Sub GoOnLine ()
  Dim I As Integer
  Dim dwValue As Long
  Dim dwSize As Long
  Dim SizeCode As Integer
  If OnLineFlag Then
    Exit Sub
  End If
  'set size.
  dwSize = 512&
  SizeCode = Size512
  'allocate RX buffer
  dwValue = GlobalDosAlloc(dwSize)
  If dwValue Then
    'get selector
    RxSelector = (&HFFFF& And dwValue)
    LockCount = GlobalPageLock(RxSelector)
    If LockCount = 0 Then
      SIMPLE.Print "LockCount error"
      End
    End If
  End If
  'allocating RX buffer
  Code = SioRxBuf(ThePort, RxSelector, SizeCode)
  If Code < 0 Then
    SIMPLE.Print "Cannot allocate RX buffer"
    End
  End If
  'allocate TX buffer
  dwValue = GlobalDosAlloc(dwSize)
  If dwValue Then
    'get selector
    TxSelector = (&HFFFF& And dwValue)
    LockCount = GlobalPageLock(TxSelector)
    If LockCount = 0 Then
      SIMPLE.Print "LockCount error"
      End
    End If
  End If
  Code = SioTxBuf(ThePort, TxSelector, SizeCode)
  If Code < 0 Then
    SIMPLE.Print "Cannot allocate TX buffer"
    End
  End If
  'reset the port
  Code = SioReset(ThePort, TheBaudCode)
  If Code < 0 Then
    SIMPLE.Print "ERROR: SioReset returns" + Str$(Code)
    End
  End If
  'call Aborting() if detect error after resetting port
  Call DisplayString("COM" + LTrim$(Str$(1 + ThePort)) + " reset")
  'set DTR & RTS
  Code = SioDTR(ThePort, Asc("S"))
  Code = SioRTS(ThePort, Asc("S"))
  'turn on hardware flow control
  Code = SioFlow(ThePort, 18)
  Call DisplayString("RTS/CTS flow control on")
  'turn on UART FIFO if 16550
  Code = SioFIFO(ThePort, LEVEL_8)
  If Code > 0 Then
    Call DisplayString("16550 Detected")
  End If
  ' set parms
  Code = SioParms(ThePort, TheParity, TheStopBits, TheDataBits)
  ' we're online !
  OnLineFlag = 1
End Sub

Sub ShowConfig ()
  Dim A As String
  Dim B As String
  Dim C As String
  Dim D As String
  Dim E As String
  If OnLineFlag Then
    A = " (Online)"
  Else
    A = " (Offline)"
  End If
  B = "COM" + LTrim$(Str$(ThePort + 1))
  C = " @ " + BaudText(TheBaudCode) + " "
  D = Str$(5 + TheDataBits) + ParityText(TheParity)
  E = LTrim$(Str$(1 + TheStopBits))
  SIMPLE.Caption = "SIMPLE: " + B + C + D + E + A
End Sub